Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/jabber1a/frmjabbe.frm

Visual Basic Form | 1999-10-05 | 17.9 KB | 569 lines

VERSION 5.00
Begin VB.Form FrmJabber
   Caption         =   "JabberWock"
   ClientHeight    =   6015
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6030
   LinkTopic       =   "Form1"
   ScaleHeight     =   6015
   ScaleWidth      =   6030
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton CmdInst
      Caption         =   "Help"
      Height          =   375
      Left            =   4920
      TabIndex        =   34
      Top             =   4920
      Width           =   1095
   End
   Begin VB.CommandButton CmdSN
      Caption         =   "Save Names"
      Height          =   375
      Left            =   4920
      TabIndex        =   18
      Top             =   5280
      Width           =   1095
   End
   Begin VB.CommandButton CmdExit
      Caption         =   "Exit"
      Height          =   375
      Left            =   4920
      TabIndex        =   19
      Top             =   5640
      Width           =   1095
   End
   Begin VB.CommandButton CmdAbt
      Caption         =   "About"
      Height          =   375
      Left            =   4920
      TabIndex        =   17
      Top             =   4560
      Width           =   1095
   End
   Begin VB.Frame Frame3
      Caption         =   "Word Options"
      Height          =   1455
      Left            =   0
      TabIndex        =   26
      Top             =   4560
      Width           =   4815
      Begin VB.OptionButton OptFirst
         Caption         =   "Start Randomly"
         Height          =   255
         Index           =   0
         Left            =   2880
         TabIndex        =   35
         Top             =   600
         Width           =   1815
      End
      Begin VB.CommandButton CmdOptions
         Caption         =   "Save Options"
         Height          =   255
         Left            =   2880
         TabIndex        =   11
         Top             =   240
         Width           =   1455
      End
      Begin VB.TextBox TxtMin
         Height          =   285
         Left            =   120
         TabIndex        =   7
         Top             =   480
         Width           =   375
      End
      Begin VB.TextBox TxtMax
         Height          =   285
         Left            =   120
         TabIndex        =   8
         Top             =   1080
         Width           =   375
      End
      Begin VB.OptionButton OptFirst
         Caption         =   "Start With Consonant"
         Height          =   255
         Index           =   1
         Left            =   2880
         TabIndex        =   12
         Top             =   840
         Value           =   -1  'True
         Width           =   1815
      End
      Begin VB.OptionButton OptFirst
         Caption         =   "Start With Vowel"
         Height          =   255
         Index           =   2
         Left            =   2880
         TabIndex        =   13
         Top             =   1080
         Width           =   1695
      End
      Begin VB.TextBox TxtStart
         Height          =   285
         Left            =   1560
         MaxLength       =   10
         TabIndex        =   9
         Top             =   480
         Width           =   1215
      End
      Begin VB.TextBox TxtEnd
         Height          =   285
         Left            =   1560
         MaxLength       =   10
         TabIndex        =   10
         Top             =   1080
         Width           =   1215
      End
      Begin VB.Label Label1
         Caption         =   "Min word Length:"
         Height          =   255
         Left            =   120
         TabIndex        =   30
         Top             =   240
         Width           =   1335
      End
      Begin VB.Label Label2
         Caption         =   "Max word Length:"
         Height          =   255
         Left            =   120
         TabIndex        =   29
         Top             =   840
         Width           =   1335
      End
      Begin VB.Label Label3
         Caption         =   "Starting Letter(s)"
         Height          =   255
         Left            =   1560
         TabIndex        =   28
         Top             =   240
         Width           =   1335
      End
      Begin VB.Label Label4
         Caption         =   "Ending Letter(s)"
         Height          =   255
         Left            =   1560
         TabIndex        =   27
         Top             =   840
         Width           =   1335
      End
   End
   Begin VB.Frame Frame2
      Caption         =   "Letters File"
      Height          =   1215
      Left            =   3120
      TabIndex        =   23
      Top             =   3240
      Width           =   2895
      Begin VB.CommandButton CmdNew
         Caption         =   "New"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   840
         Width           =   735
      End
      Begin VB.CommandButton CmdSave
         Caption         =   "Save"
         Height          =   255
         Left            =   2040
         TabIndex        =   16
         Top             =   840
         Width           =   735
      End
      Begin VB.TextBox TxtFileName
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Left            =   120
         Locked          =   -1  'True
         MaxLength       =   100
         TabIndex        =   24
         Top             =   480
         Width           =   2655
      End
      Begin VB.CommandButton CmdOpen
         Caption         =   "Open"
         Height          =   255
         Left            =   1080
         TabIndex        =   15
         Top             =   840
         Width           =   735
      End
      Begin VB.Label Label5
         Caption         =   "File name:"
         Height          =   255
         Left            =   120
         TabIndex        =   25
         Top             =   240
         Width           =   2655
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Add/Remove/Generate"
      Height          =   1215
      Left            =   0
      TabIndex        =   22
      Top             =   3240
      Width           =   3015
      Begin VB.CommandButton CmdClear
         Caption         =   "Clear Names"
         Height          =   255
         Left            =   1680
         TabIndex        =   6
         Top             =   720
         Width           =   1215
      End
      Begin VB.OptionButton OptCV
         Caption         =   "Vowel"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   3
         Top             =   840
         Width           =   1215
      End
      Begin VB.OptionButton OptCV
         Caption         =   "Consonant"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   2
         Top             =   600
         Value           =   -1  'True
         Width           =   1215
      End
      Begin VB.CommandButton CmdAdd
         Caption         =   "Add"
         Height          =   255
         Left            =   1680
         TabIndex        =   4
         Top             =   240
         Width           =   1215
      End
      Begin VB.TextBox TxtAR
         Height          =   285
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   1215
      End
      Begin VB.CommandButton CmdGen
         Caption         =   "Make Names"
         Height          =   255
         Left            =   1680
         TabIndex        =   5
         Top             =   480
         Width           =   1215
      End
   End
   Begin VB.ListBox LstNam
      Height          =   2985
      ItemData        =   "FrmJabber.frx":0000
      Left            =   4080
      List            =   "FrmJabber.frx":0002
      TabIndex        =   21
      TabStop         =   0   'False
      ToolTipText     =   "Double click to remove items"
      Top             =   240
      Width           =   1935
   End
   Begin VB.ListBox LstVow
      Height          =   2985
      ItemData        =   "FrmJabber.frx":0004
      Left            =   2040
      List            =   "FrmJabber.frx":0006
      TabIndex        =   20
      TabStop         =   0   'False
      ToolTipText     =   "Double click to remove items"
      Top             =   240
      Width           =   1935
   End
   Begin VB.ListBox LstCon
      Height          =   2985
      ItemData        =   "FrmJabber.frx":0008
      Left            =   0
      List            =   "FrmJabber.frx":000A
      TabIndex        =   0
      TabStop         =   0   'False
      ToolTipText     =   "Double click to remove items"
      Top             =   240
      Width           =   1935
   End
   Begin VB.Label Label8
      Alignment       =   2  'Center
      Caption         =   "Generated Names"
      Height          =   255
      Left            =   4080
      TabIndex        =   33
      Top             =   0
      Width           =   1935
   End
   Begin VB.Label Label7
      Alignment       =   2  'Center
      Caption         =   "Vowels"
      Height          =   255
      Left            =   2040
      TabIndex        =   32
      Top             =   0
      Width           =   1935
   End
   Begin VB.Label Label6
      Alignment       =   2  'Center
      Caption         =   "Consonants"
      Height          =   255
      Left            =   0
      TabIndex        =   31
      Top             =   0
      Width           =   1935
   End
Attribute VB_Name = "FrmJabber"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const OptFile As String = "\option.dat"
Dim OptionFile As String, OptLen As Integer, DefaultPath As String, Dirty As Boolean, LetterFile As String
Private Sub CmdAdd_Click() 'Add contents of textbox to the listbox
TxtAR.SetFocus
' If the textbox is empty, exit
If TxtAR.Text = "" Then
    Beep
    Exit Sub
End If
' Check to see which one to add it to
If OptCV(0).Value = True Then
    LstCon.AddItem TxtAR.Text
    LstVow.AddItem TxtAR.Text
End If
' Clear the textbox
TxtAR.Text = ""
' List has changed, it's "Dirty"
Dirty = True
End Sub
Private Sub CmdClear_Click()
' Clears name list
LstNam.Clear
End Sub
Private Sub CmdGen_Click()
Dim Words As String, WPast As String, WordLen As Integer
Dim RI As Integer, X As Integer
Dim L As Integer, LPast As Integer
For X = 1 To 100
    Words = "" ' Clear word
    ' Get random word length
    WordLen = GRI(Val(TxtMin.Text), Val(TxtMax.Text))
    ' Decide whether consonant, vowel, or random
    Select Case Trim(Opt.First)
        Case Is = 1
            L = 2
        Case Is = 2
            L = 1
        Case Else
            L = GRI(1, 2)
    End Select
    ' Do until the length is correct
    Do
        LPast = L ' Rember whether last was consonant or vowel
        L = L + 1 ' Change to other
        If L = 3 Then L = 1 ' 3 is out of bounds, change to 1
        ' Pick consonant if 1, vowel if 2
        If L = 1 Then RI = GRI(0, LstCon.ListCount - 1): Words = Words + LstCon.List(RI)
        If L = 2 Then RI = GRI(0, LstVow.ListCount - 1): Words = Words + LstVow.List(RI)

        ' If word is too long, reset everything
        If Len(Words) > WordLen Then: Words = WPast: L = LPast
        WPast = Words ' Remembers words
    Loop Until Len(Words) = WordLen
    ' Add first and last parts to word
    If TxtStart.Text <> "" Then Words = TxtStart.Text + Words
    If TxtEnd.Text <> "" Then Words = Words + TxtEnd.Text
    ' Convert word to propper case
    Words = StrConv(Words, vbProperCase)
    ' Add name to list
    LstNam.AddItem Words
End Sub
Private Sub CmdAbt_Click() ' About this program
MsgBox "JabberWin 1.0" & vbNewLine & vbNewLine & _
        "Based upon Jaberwock for DOS:" & "(c)opyright 1998 by Steven Duggar ([e-mail])" & vbNewLine & vbNewLine & _
        "Original VB code: (c)opyright 1999 by Phillip Riley ([e-mail])" & vbNewLine & vbNewLine & _
        "100% compatable with datafiles and alphabets from the original JabberWin.", _
        vbInformation, "About this Program"

End Sub
Private Sub CmdExit_Click()
If Dirty Then
    Resp = MsgBox("Do you want to save this list?", vbYesNo, "Save list")
    If Resp = vbYes Then CmdSave_Click
End If
' Save options
CmdOptions_Click
' End Program
End Sub
Private Sub CmdInst_Click()
MsgBox "JabberWin 1.0" & vbNewLine & vbNewLine & _
        "JW generally follows a '...consonant-vowel-consonant-vowel...' format," & vbNewLine & _
        "which is the pattern of most human language.", _
        vbInformation, "How it works"
End Sub
Private Sub CmdNew_Click()
Dim Resp As String
' If dirty prompt to save, if not name the file
If Dirty Then
    Resp = MsgBox("Do you want to save this list?", vbYesNo, "Save list")
    If Resp = vbYes Then CmdSave_Click
    FileNames = InputBox("What do you want to call this file?", "Enter Filename", "letters.dat")
    If Trim(FileNames) = "" Then Exit Sub
    LstCon.Clear
    LstVow.Clear
    Opt.WordFile = DefaultPath & "\" & FileNames
    TxtFileName.Text = Opt.WordFile
End If
End Sub
Private Sub CmdOpen_Click()
Dim Resp As String, FileNam As String
' If dirty, prompt to save, if not open letters
If Dirty Then
    Resp = MsgBox("Do you want to save this list?", vbYesNo, "Save list")
    If Resp = vbYes Then CmdSave_Click
    FileNam = DialogFile(FrmJabber, 1, "Open Letters List", "", "*.DAT", DefaultPath, ".dat")
    If Len(FileNam) = 0 Then Exit Sub
    TxtFileName.Text = FileNam
    LstCon.Clear
    LstVow.Clear
    LstNam.Clear
    OpenLetters
End If
End Sub
Private Sub CmdOptions_Click()
' Get free file number
FileNum = FreeFile
' Get options
Opt.MaxWordLen = TxtMax
Opt.MinWordLen = TxtMin
Opt.WordFinal = TxtEnd
Opt.WordInit = TxtStart
Opt.WordFile = TxtFileName
For X = 0 To 2
    If OptFirst(X).Value = True Then Opt.First = X
' Write options to file
Open App.Path & OptFile For Output As #FileNum
    Write #FileNum, Opt.MinWordLen, Opt.MaxWordLen, Opt.WordFile, Opt.First, Opt.WordInit, Opt.WordFinal
Close #1
End Sub
Private Sub CmdSave_Click()
Dim FileNum As Integer
On Error GoTo ErrorHandler
' Get filename & path
FileNames = DialogFile(FrmJabber, 2, "Save Letters List", "", "*.DAT", DefaultPath, ".dat")
' Get file number
FileNum = FreeFile
' If nothing, exit sub
If Len(FileNames) = 0 Then Exit Sub
' Write list to file
Open FileNames For Output As #FileNum
    Print #FileNum, "NUMBER OF CONSONANTS:"
    Print #FileNum, LstCon.ListCount
    Print #FileNum, "CONSONANTS:"
    For X = 0 To LstCon.ListCount - 1
        Print #FileNum, LstCon.List(X)
    Next
    Print #FileNum, "NUMBER OF VOWELS:"
    Print #FileNum, LstVow.ListCount
    Print #FileNum, "VOWELS:"
    For X = 0 To LstVow.ListCount - 1
        Print #FileNum, LstVow.List(X)
    Next
Close
'Change default path
DefaultPath = ExtractPath(FileNames)
ErrorHandler:
Exit Sub
End Sub
Private Sub CmdSN_Click()
Dim FileNum As Integer
On Error GoTo ErrorHandler
' Get file name
FileNames = DialogFile(FrmJabber, 2, "Save Names List", "Names.txt", "*.TXT", DefaultPath, ".txt")
' Get fiel number
FileNum = FreeFile
' If nothing exit sub
If Len(FileNames) = 0 Then Exit Sub
' Write names to file
Open FileNames For Output As #FileNum
    For X = 0 To LstNam.ListCount - 1
        Print #FileNum, LstNam.List(X)
    Next
Close
'Change default path
DefaultPath = ExtractPath(FileNames)
ErrorHandler:
Exit Sub
End Sub
Private Sub Form_Load()
' Change Form caption
Me.Caption = App.Title + " " + "1.0"
' Get File number
FileNum = FreeFile
' Get options from file
Open App.Path & OptFile For Input As #FileNum
    Input #FileNum, Opt.MinWordLen, Opt.MaxWordLen, Opt.WordFile, Opt.First, Opt.WordInit, Opt.WordFinal
Close #1
' Display options
TxtMax.Text = Trim(Opt.MaxWordLen)
TxtMin.Text = Trim(Opt.MinWordLen)
TxtEnd.Text = Trim(Opt.WordFinal)
TxtStart.Text = Trim(Opt.WordInit)
TxtFileName.Text = Trim(Opt.WordFile)
OptFirst(Opt.First).Value = True
' Open last letters file
OpenLetters
' Set default path
DefaultPath = ExtractPath(Opt.WordFile)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
' Save options
CmdOptions_Click
End Sub
Private Sub LstCon_DblClick()
' Remove selected item
LstCon.RemoveItem (LstCon.ListIndex)
Dirty = True
End Sub
Private Sub LstNam_DblClick()
' Remove selected item
LstNam.RemoveItem (LstNam.ListIndex)
Dirty = True
End Sub
Private Sub LstVow_DblClick()
' Remove selected item
LstVow.RemoveItem (LstVow.ListIndex)
Dirty = True
End Sub
Private Sub OptFirst_Click(Index As Integer)
Opt.First = Index
End Sub
Private Sub TxtAR_GotFocus()
' Select entire textbox
TxtAR.SelStart = 0
TxtAR.SelLength = Len(TxtAR.Text)
End Sub
Private Sub TxtEnd_GotFocus()
' Select entire textbox
TxtEnd.SelStart = 0
TxtEnd.SelLength = Len(TxtEnd.Text)
End Sub
Private Sub TxtMax_GotFocus()
' Select entire textbox
TxtMax.SelStart = 0
TxtMax.SelLength = Len(TxtMax.Text)
End Sub
Private Sub TxtMin_GotFocus()
' Select entire textbox
TxtMin.SelStart = 0
TxtMin.SelLength = Len(TxtMin.Text)
End Sub
Private Sub TxtStart_GotFocus()
' Select entire textbox
TxtStart.SelStart = 0
TxtStart.SelLength = Len(TxtStart.Text)
End Sub